Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / games.arc / MAIL.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1980-01-01 | 7.0 KB | 313 lines

10 ' ******************** 20 ' *** MAIL *** 30 ' ******************** 40 ' 50 CLEAR 60 SCREEN 0,0,0,0 70 WIDTH 80 80 KEY OFF 90 OPEN "MAILDATA" AS #1 100 FIELD #1,30 AS N$,30 AS A$,20 AS T$,2 AS S$,5 AS Z$,11 AS C$ 110 FIELD #1,99 AS X$ 120 ZERO$ = STRING$(99,0) 130 BLANK$ = SPACE$(99) 140 PTR.LAST = PTR.LAST + 1 150 GET #1,PTR.LAST 160 IF X$ <> ZERO$ THEN 140 170 PTR.LAST = PTR.LAST - 1 180 ON KEY(1) GOSUB 580 190 ON KEY(2) GOSUB 650 200 ON KEY(3) GOSUB 710 210 ON KEY(4) GOSUB 790 220 ON KEY(5) GOSUB 1100 230 ON KEY(6) GOSUB 1240 240 ON KEY(7) GOSUB 1510 250 ON KEY(8) GOSUB 1970 260 ON KEY(9) GOSUB 2400 270 ON KEY(10) GOSUB 2710 280 GOSUB 3080 290 ' 300 CLS 310 LOCATE 1,27 320 PRINT "* * * M A I L * * * 330 PRINT 340 PRINT STRING$(80,"="); 350 LOCATE 11 360 PRINT STRING$(80,"="); 370 FOR I = 1 TO 10 380 READ MENU$ 390 LOCATE 12+I,17 400 PRINT MENU$ 410 NEXT I 420 DATA F1. Get the next address in the file 430 DATA F2. Get the previous address in the file 440 DATA F3. Enter a new address to the file 450 DATA F4. Edit the displayed address 460 DATA F5. Delete the displayed address from the file 470 DATA F6. Find a file entry 480 DATA F7. Sort the file 490 DATA F8. Print mailing labels 500 DATA F9. List state abbreviations 510 DATA F10. Quit 520 GOSUB 580 530 ' 540 WHILE NOT RAIN OR SNOW 550 KEY.BUFFER.CLEAR$ = INKEY$ 560 WEND 570 ' 580 ' Subroutine F1, next address 590 PTR = PTR - (PTR < PTR.LAST) 600 IF PTR = 0 THEN PTR = 1 : PTR.LAST = 1 610 GET #1,PTR 620 GOSUB 2750 630 RETURN 640 ' 650 ' Subroutine F2, previous address 660 PTR = PTR + (PTR > 1) 670 GET #1,PTR 680 GOSUB 2750 690 RETURN 700 ' 710 ' Subroutine F3, enter new address 720 IF X$ = BLANK$ OR X$ = ZERO$ THEN 760 730 PTR = PTR.LAST + 1 740 PTR.LAST = PTR 750 LSET X$ = BLANK$ 760 GOSUB 790 770 RETURN 780 ' 790 ' Subroutine F4, edit displayed address 800 GOSUB 3020 810 SCREEN 0,0,1,0 820 CLS 830 GOSUB 2750 840 SCREEN 0,0,1,1 850 LOCATE 12 860 IF X$ = BLANK$ OR X$ = ZERO$ THEN 880 870 PRINT "Just press <enter> if a data item is not to be changed ... 880 PRINT 890 INPUT "Name ... ";NAIM$ 900 INPUT "Street ... ";ADDRESS$ 910 INPUT "Town ... ";TOWN$ 920 INPUT "State (2 letters) ";STATE$ 930 INPUT "Zip code ... ";ZIP$ 940 INPUT "Comments/codes ... ";CODE$ 950 IF NAIM$ <> "" THEN LSET N$ = NAIM$ 960 IF ADDRESS$ <> "" THEN LSET A$ = ADDRESS$ 970 IF TOWN$ <> "" THEN LSET T$ = TOWN$ 980 IF STATE$ <> "" THEN LSET S$ = STATE$ 990 IF ZIP$ <> "" THEN LSET Z$ = ZIP$ 1000 IF CODE$ <> "" THEN LSET C$ = CODE$ 1010 CAP$ = X$ 1020 GOSUB 2940 1030 LSET X$ = CAP$ 1040 SCREEN 0,0,0,0 1050 GOSUB 2750 1060 PUT #1,PTR 1070 GOSUB 3080 1080 RETURN 1090 ' 1100 ' Subroutine F5, delete displayed address 1110 GOSUB 3020 1120 IF PTR.LAST = PTR THEN 1150 1130 GET #1,PTR.LAST 1140 PUT #1,PTR 1150 LSET X$ = ZERO$ 1160 PUT #1,PTR.LAST 1170 PTR.LAST = PTR.LAST + (PTR.LAST > 1) 1180 IF PTR > PTR.LAST THEN PTR = PTR.LAST 1190 GET #1,PTR 1200 GOSUB 2750 1210 GOSUB 3080 1220 RETURN 1230 ' 1240 ' Subroutine F6, find an address 1250 GOSUB 3020 1260 SCREEN 0,0,1,1 1270 CLS 1280 LOCATE 7,7 1290 IF FIND$ = "" THEN 1330 1300 PRINT "Current search characters are ";CHR$(34);FIND$;CHR$(34); 1310 PRINT "Just press <enter> to search for next occurence ..."; 1320 PRINT 1330 PRINT 1340 LINE INPUT "Enter string of characters to find in file ... ";CAP$ 1350 IF CAP$ = "" THEN 1390 1360 GOSUB 2950 1370 FIND$ = CAP$ 1380 IF FIND2$ <> "" THEN FIND$ = FIND2$ 1390 CNT = 1 1400 PTR = PTR MOD PTR.LAST + 1 1410 CNT = CNT + 1 1420 IF CNT > PTR.LAST THEN BEEP : GOTO 1450 1430 GET #1,PTR 1440 IF INSTR(X$,FIND$) = 0 THEN 1400 1450 GET #1,PTR 1460 SCREEN 0,0,0,0 1470 GOSUB 2750 1480 GOSUB 3080 1490 RETURN 1500 ' 1510 ' Subroutine F7, sort the file 1520 GOSUB 3020 1530 SCREEN 0,0,1,1 1540 CLS 1550 PRINT "A. Name 1560 PRINT "B. Street 1570 PRINT "C. Town 1580 PRINT "D. State 1590 PRINT "E. Zip code 1600 PRINT "F. Comment/code 1610 PRINT 1620 PRINT "Z. Don't sort ... go back to main menu 1630 PRINT 1640 PRINT "Select the field for the sort ..."; 1650 CAP$ = INKEY$ 1660 IF CAP$ = "" THEN 1650 1670 GOSUB 2940 1680 IF CAP$ < "A" OR CAP$ > "F" THEN 1900 1690 LOCATE 12,17 1700 PRINT "Sorting by field ";CAP$;" ..."; 1710 IF CAP$ = "A" THEN SPTR = 1 : SLEN = 30 1720 IF CAP$ = "B" THEN SPTR = 31 : SLEN = 30 1730 IF CAP$ = "C" THEN SPTR = 61 : SLEN = 20 1740 IF CAP$ = "D" THEN SPTR = 81 : SLEN = 2 1750 IF CAP$ = "E" THEN SPTR = 83 : SLEN = 5 1760 IF CAP$ = "F" THEN SPTR = 88 : SLEN = 11 1770 IZ = 0 1780 IZ = IZ + 1 1790 IS = IZ 1800 IF IS = PTR.LAST THEN 1900 1810 GET #1,IS 1820 X2$ = X$ 1830 GET #1,IS + 1 1840 IF MID$(X2$,SPTR,SLEN) <= MID$(X$,SPTR,SLEN) THEN 1780 1850 PUT #1,IS 1860 LSET X$ = X2$ 1870 PUT #1,IS + 1 1880 IS = IS + (IS > 1) 1890 GOTO 1810 1900 SCREEN 0,0,0,0 1910 PTR = 1 1920 GET #1,PTR 1930 GOSUB 2760 1940 GOSUB 3080 1950 RETURN 1960 ' 1970 ' Subroutine F8, print mailing labels 1980 GOSUB 3020 1990 SCREEN 0,0,1,1 2000 CLS 2010 LOCATE 12,12 2020 INPUT "How many labels across ";NLA 2030 IF NLA = 1 THEN 2050 2040 INPUT "Number of characters across from label to label ";NALL 2050 INPUT "Number of lines down from label to label ";NDLL 2060 INPUT "First label number to print (if not no. 1) ";START 2070 IF START = 0 THEN START = 1 2080 INPUT "Last label number to print (if not entire file) ";FINISH 2090 IF FINISH = 0 THEN FINISH = PTR.LAST 2100 INPUT "Want to change any of these values (y/n) ";CHNG$ 2110 IF CHNG$ = "y" OR CHNG$ = "Y" THEN 2000 2120 LOCATE 20 2130 PRINT "Press any key if you want to stop printing labels ... 2140 STPFLAG = 0 2150 FOR LABEL = START TO FINISH STEP NLA 2160 KY$ = INKEY$ 2170 IF KY$ <> "" THEN STPFLAG = 1 2180 IF STPFLAG THEN 2350 2190 PN$ = SPACE$(80) 2200 PA$ = PN$ 2210 PT$ = PN$ 2220 FOR INC = 1 TO NLA 2230 IF LABEL + INC - 1 > FINISH THEN 2300 2240 GET #1,LABEL + INC - 1 2250 TC = (INC - 1) * NALL + 1 2260 MID$(PN$,TC,30) = N$ 2270 MID$(PA$,TC,30) = A$ 2280 MID$(PT$,TC,20) = T$ 2290 MID$(PT$,TC+INSTR(T$," "),8) = S$ + " " + Z$ 2300 NEXT INC 2310 LPRINT PN$;PA$;PT$; 2320 FOR CNT = 4 TO NDLL 2330 LPRINT 2340 NEXT CNT 2350 NEXT LABEL 2360 SCREEN 0,0,0,0 2370 GOSUB 3080 2380 RETURN 2390 ' 2400 ' Subroutine F9, list state abbreviations 2410 GOSUB 3020 2420 SCREEN 0,0,2,2 2430 IF ST.ABBREV$ <> "" THEN 2650 2440 CLS 2450 FOR I = 1 TO 51 2460 LOCATE (I - 1) MOD 17 + 4, INT((I - 1) / 17) * 26 + 7 2470 READ ST.ABBREV$ 2480 PRINT ST.ABBREV$; 2490 NEXT I 2500 DATA AL Alabama,AK Alaska,AZ Arizona,AR Arkansas,CA California 2510 DATA CO Colorado,CT Connecticut,DE Delaware,DC District of Columbia 2520 DATA FL Florida,GA Georgia,HI Hawaii,ID Idaho,IL Illinois,IN Indiana 2530 DATA IA Iowa,KS Kansas,KY Kentucky,LA Louisiana,ME Maine,MD Maryland 2540 DATA MA Massachusetts,MI Michigan,MN Minnesota,MS Mississippi 2550 DATA MO Missourri,MT Montana,NE Nebraska,NV Nevada,NH New Hampshire 2560 DATA NJ New Jersey,NM New Mexico,NY New York,NC North Carolina 2570 DATA ND North Dakota,OH Ohio,OK Oklahoma,OR Oregon,PA Pennsylvania 2580 DATA RI Rhode Island,SC South Carolina,SD South Dakota,TN Tennessee 2590 DATA TX Texas,UT Utah,VT Vermont,VA Virginia,WA Washington 2600 DATA WV West Virginia,WI Wisconsin,WY Wyoming 2610 LOCATE 1,25 2620 PRINT "TWO-LETTER STATE ABBREVIATIONS"; 2630 LOCATE 25,27 2640 PRINT "Press space bar to continue"; 2650 KY$ = INKEY$ 2660 IF KY$ <> " " THEN 2650 2670 SCREEN 0,0,0,0 2680 GOSUB 3080 2690 RETURN 2700 ' 2710 ' Subroutine F10, quit 2720 CLS 2730 END 2740 ' 2750 ' Subroutine, put current address on display 2760 LOCATE 2,1 2770 PRINT PTR;" "; 2780 LOCATE 7,35 2790 PRINT STRING$(17,32); 2800 LOCATE 5,22 2810 PRINT N$; 2820 LOCATE 6,22 2830 PRINT A$; 2840 LOCATE 7,22 2850 PRINT T$;" "; 2860 LOCATE ,POS(0) - 1 2870 IF SCREEN(CSRLIN,POS(0)) = 32 AND POS(0) > 22 THEN 2860 2880 LOCATE ,POS(0) + 2 2890 PRINT S$;" ";Z$; 2900 LOCATE 9,22 2910 PRINT C$; 2920 RETURN 2930 ' 2940 ' Subroutine, capitalize CAP$ 2950 FOR CHAR = 1 TO LEN(CAP$) 2960 CHAR$ = MID$(CAP$,CHAR,1) 2970 IF CHAR$ < "a" OR CHAR$ > "z" THEN 2990 2980 MID$(CAP$,CHAR,1) = CHR$(ASC(CHAR$) - 32) 2990 NEXT CHAR 3000 RETURN 3010 ' 3020 ' Subroutine, deactivate special function keys 3030 FOR KEYPTR = 1 TO 10 3040 KEY (KEYPTR) OFF 3050 NEXT KEYPTR 3060 RETURN 3070 ' 3080 ' Subroutine, activate special function keys 3090 FOR KEYPTR = 1 TO 10 3100 KEY (KEYPTR) ON 3110 NEXT KEYPTR 3120 RETURN